/*
  Distributed under the terms of GNU LGPL
  (c) 2009 Paul Graphov <graphov@gmail.com>
*/

#ifndef __ZEPTO_H__
#define __ZEPTO_H__

#define _GNU_SOURCE

#include <sys/types.h>
#include <stdlib.h>
#include <stdio.h>
#include <search.h>
#include <wchar.h>
#include "list.h"

#define MAX_DEPTH 100
#define DEFAULT_STR_LEN 20

#define ERROR(...)                                  \
  {                                                 \
    printf("%s -- %s -- line %d: ", __FILE__,       \
           __PRETTY_FUNCTION__, __LINE__);          \
    printf(__VA_ARGS__);                            \
    printf("\n");                                   \
    abort();                                        \
  }

extern int zepto_errno;

enum {
  ZEPTO_SUCCESS,
  ZEPTO_TOK_PARSEERROR,
  ZEPTO_TOK_MALFORMED_NUM,
  ZEPTO_TOK_ENOMEM,
  ZEPTO_TOK_UNEXPECTED_EOF,
  ZEPTO_TOK_MISMATCHED_PAREN,
  ZEPTO_TOK_INVALID_SEQ,
  ZEPTO_EXPR_INCOMPLETE,
  ZEPTO_EXPR_ENOMEM,
  ZEPTO_EXPR_UNEXPECTED_TOKEN,
};

struct zepto;
struct cons;

// expression types
typedef enum zepto_type {
  ZEPTO_SYMBOL,
  ZEPTO_STRING,
  ZEPTO_BOOL,
  ZEPTO_INTEGER,
  ZEPTO_PAIR,
  ZEPTO_NIL,
  ZEPTO_ENV,
  ZEPTO_CLOSURE,
  ZEPTO_STREAM,
  ZEPTO_CHAR,
  ZEPTO_BUILTIN,
} zepto_type_t;

typedef enum __tok_type {
  TOK_SYMBOL,
  TOK_STRING,
  TOK_TRUE,
  TOK_FALSE,
  TOK_INTEGER,
  TOK_OP_B,
  TOK_CL_B,
  TOK_DOT,
  TOK_QUOTE,
} tok_type_t;

struct cons {
  struct zepto *car;
  struct zepto *cdr;
};

struct env {
  struct list_head next; // single linked list for M&S garbage collection
  unsigned char gc_mark;
  struct env *super;
  void *records;
};

struct eval_data {
  unsigned char arg_count : 2;
  unsigned char eval_mask : 3;
  unsigned char have_tail : 2;
  unsigned char eval_tail : 1;
};

struct closure {
  struct env *env;
  struct zepto *arg_list;
  struct zepto *body;
};

typedef struct zepto *(*builtin_routine)(struct env *env, struct zepto *arg1,
                                         struct zepto *arg2, struct zepto *tail);

struct builtin {
  char *name;
  struct eval_data eval_data;
  unsigned char func_num;
  builtin_routine routine;
};

typedef enum stream_mode {
  STREAM_IN,
  STREAM_OUT,
} stream_mode_t;

struct stream_ops {
  int (*sgetc)(void *stream);
  char *(*sgets)(void *stream);
  int (*sungetc)(void *stream, int c);
  int (*sputc)(void *stream, char c);
  int (*sputs)(void *stream, const char *str);
  int (*sclose)(void *stream);
  int (*seof)(void *stream);
};

struct stream {
  struct list_head next; // single linked list for M&S garbage collection
  unsigned char gc_mark;
  void *data;
  struct stream_ops *ops;
};

struct string {
  unsigned int length;
  wchar_t *data;
};

void *zepto_alloc_general(size_t size);
#define zepto_alloc(type) zepto_alloc_general(sizeof(type))

void zepto_gc(void);

#define ALLOC_AND_SET_TYPE(type_name, type_no)                          \
  static inline struct zepto_##type_name *alloc_##type_name()           \
  {                                                                     \
    struct zepto_##type_name *res =                                     \
      zepto_alloc_general(sizeof(struct zepto_##type_name));            \
    res->type = type_no;                                                \
    return res;                                                         \
  }

#ifndef PARANOIC_TYPE_CHEKING
#define PARANOIC_TYPE_ASSERT(x, type_no) ASSERT((x)->type == type_no)
#else
#define PARANOIC_TYPE_ASSERT(x, type_no)
#endif

#define TYPE_CONVERT(name, val_type, type_no, is_struct)       \
  static inline is_struct val_type *as_##name(struct zepto *x) \
  {                                                            \
    PARANOIC_TYPE_ASSERT((x)->type == type_no);                \
    return &((struct zepto_##name *)x)->val;                   \
  }

#define TYPE_CHECK(name, type_no)               \
  static inline void check_##name(struct zepto *x)      \
  {                                                     \
    ASSERT((x)->type == type_no);                       \
  }

#define DECLARE_ZEPTO_COMMON_TYPE(name, val_type, type_no, is_struct)   \
  struct zepto_name {                                                   \
    enum zepto_type type;                                               \
    is_struct val_type data;                                            \
  };                                                                    \
  ALLOC_AND_SET_TYPE(name, type_no);                                    \
  TYPE_CONVERT(name, val_type, type_no, is_struct);                     \
  TYPE_CHECK(name, type_no);

#define DELCARE_ZEPTO_STRUCT_TYPE(name, val_type, type_no)      \
  DECLARE_ZEPTO_COMMON_TYPE(name, val_type, type_no, struct)

#define DELCARE_ZEPTO_SCALAR_TYPE(name, val_type, type_no)      \
  DECLARE_ZEPTO_COMMON_TYPE(name, val_type, type_no, )


DECLARE_ZEPTO_SCALAR_TYPE(bool, bool, ZEPTO_BOOL);
DECLARE_ZEPTO_SCALAR_TYPE(integer, long, ZEPTO_INTEGER);
DECLARE_ZEPTO_SCALAR_TYPE(symbol, char*, ZEPTO_SYMBOL);
DECLARE_ZEPTO_SCALAR_TYPE(char, wchar_t, ZEPTO_CHAR);
DECLARE_ZEPTO_STRUCT_TYPE(pair, cons, ZEPTO_PAIR);
DECLARE_ZEPTO_STRUCT_TYPE(builtin, builtin, ZEPTO_BUILTIN);
DECLARE_ZEPTO_STRUCT_TYPE(closure, closure, ZEPTO_CLOSURE);
DECLARE_ZEPTO_STRUCT_TYPE(env, env, ZEPTO_ENV);
DECLARE_ZEPTO_STRUCT_TYPE(string, string, ZEPTO_STRING);
DECLARE_ZEPTO_STRUCT_TYPE(stream, stream, ZEPTO_STREAM);

// common struct for unknown-typed data
struct zepto {
  enum zepto_type type;
};

// type conversion
#ifndef PARANOIC_TYPE_CHEKING
#define TYPE_CONVERT(name, type, type_no) (((type *)name)->val)
#else
#define TYPE_CONVERT(name, type, type_no) \
  ({                                      \
    ASSERT((name)->type == type_no);      \
    (((type *)name)->val);                \
  })
#endif
#define TYPE_CONVERT(name, type, type_no) \
  ({                                      \
    ASSERT((name)->type == type_no);      \
    (((type *)name)->val);                \
  })


#define INTEGER(x) TYPE_CONVERT(x, zepto_integer, ZEPTO_INTEGER)
#define BOOL(x) TYPE_CONVERT(x, zepto_bool, ZEPTO_BOOL)
#define SYMBOL(x) TYPE_CONVERT(x, zepto_symbol, ZEPTO_SYMBOL)
#define CHAR(x) TYPE_CONVERT(x, zepto_char, ZEPTO_CHAR)
#define PAIR(x) TYPE_CONVERT(x, zepto_pair, ZEPTO_PAIR)
#define FUNCTION(x) TYPE_CONVERT(x, zepto_function, ZEPTO_FUNCTION)
#define ENV(x) TYPE_CONVERT(x, zepto_env, ZEPTO_ENV)
#define STRING(x) TYPE_CONVERT(x, zepto_string, ZEPTO_STRING)
#define STREAM(x) TYPE_CONVERT(x, zepto_stream, ZEPTO_STREAM)

wchar_t *zepto_wcsdup(const wchar_t *str);

struct token {
  struct list_head list;
  enum zepto_type type;
  union zepto_data data;
};

typedef enum __state {
  ST_SPACE,
  ST_STRING,
  ST_STR_SLASH,
  ST_SYMBOL,
  ST_NUMBER,
} state_t;

extern struct zepto __holy_truth;
extern struct zepto __unholy_lie;
extern struct zepto __nil;
extern struct zepto __zero;
extern struct zepto __one;
extern struct zepto *__quote;

#define CHECK_TYPE(x, _type)                          \
  if((x)->type != _type) {                            \
    ERROR("%s must be %s.\n", #x, #_type);            \
  }

#define CHECK_NON_NULL(x)                       \
  {                                             \
    if(!(x)) {                                  \
      ERROR("%s is null.\n", #x);               \
    }                                           \
  }

#define ASSERT(e)                               \
  {                                             \
    if(!(e)) {                                  \
      ERROR("Assertion failed: %s\n", #e);      \
    }                                           \
  }                                             \

// temporary variable is used to avoid double evaluation
// of parameter
#define CHECK_ZERO(x)                               \
  {                                                 \
    int _x = (x);                                   \
    if(_x != 0) {                                   \
      ERROR("Nonzero result: %s is %d\n" #x, _x );  \
    }                                               \
  }

// this macro evaluates first parameter twice (!!!)
#define CHECK_TYPE_SAFE(x, _type)               \
  {                                             \
    CHECK_NON_NULL((x));                        \
    CHECK_TYPE((x), _type);                     \
  }                                             \

#define CAR(x) ((x)->data.pair.car)
#define CDR(x) ((x)->data.pair.cdr)

static inline struct zepto *_make_cons(struct zepto *x, struct zepto *y)
{
  struct zepto *res = zepto_alloc_pair();
  res->type = ZEPTO_PAIR;
  CAR(res) = (x);
  CDR(res) = (y);
  return res;
}

static inline struct zepto *_make_zepto_number(long val)
{
  struct zepto *res;
  res = zepto_alloc_integer();
  res->type = ZEPTO_INTEGER;
  res->data.integer = val;
  return res;
}

static inline struct zepto *_make_zepto_string(wchar_t *str, int len)
{
  struct zepto *res;
  res = zepto_alloc_string();
  res->type = ZEPTO_STRING;
  res->data.string.data = str;
  res->data.string.length = len;
  return res;
}

static inline struct zepto *_make_zepto_char(wchar_t c)
{
  struct zepto *res;
  res = zepto_alloc_char();
  res->type = ZEPTO_CHAR;
  res->data.character = c;
  return res;
}


// predefined zepto values
#define FALSE (&__unholy_lie)
#define TRUE  (&__holy_truth)
#define NIL   (&__nil)
#define ZERO  (&__zero)
#define ONE   (&__one)
#define CQUOTE  __quote

#define ZEPTO_NEG_RESULT(res, x, bad)           \
  {                                             \
    if((x) == (bad)) {                          \
      (res) = FALSE;                            \
    } else {                                    \
      (res) = TRUE;                             \
    }                                           \
  }

#define ZEPTO_TO_BOOL(cond)                     \
  ((cond) ? TRUE : FALSE)                            \

static inline struct zepto *SAFE_CAR(struct zepto *x) // with air bags
{
  CHECK_TYPE(x, ZEPTO_PAIR);
  return CAR(x);
}

static inline struct zepto *SAFE_CDR(struct zepto *x)
{
  CHECK_TYPE(x, ZEPTO_PAIR);
  return CDR(x);
}

static inline bool is_pair(struct zepto *x)
{
  return (x->type == ZEPTO_PAIR);
}

static inline bool is_number(struct zepto *x)
{
  return (x->type == ZEPTO_INTEGER);
}

static inline bool is_null(struct zepto *x)
{
  return (x->type == ZEPTO_NIL);
}

static inline bool is_string(struct zepto *x)
{
  return (x->type == ZEPTO_STRING);
}

static inline bool is_atom(struct zepto *x)
{
  return (x->type != ZEPTO_PAIR);
}

// environment management and pollution prevention:
int env_set(struct env *env, struct zepto *key, struct zepto *value);
int env_define(struct env *env, struct zepto *key, struct zepto *value);
struct zepto *env_lookup(struct env *env_expr, struct zepto *key);
struct env *env_create(struct env *super);

// low-level stream functions
stream_t *_stream_open_file(const char *path, stream_mode_t mode);
stream_t *_stream_wrap_stdio(FILE *file, stream_mode_t mode);
stream_t *_stream_open_string(char *string, stream_mode_t mode);

static inline int _stream_getc(stream_t *stream)
{
  return (stream->ops->sgetc(stream->data));
}

static inline char *_stream_gets(stream_t *stream)
{
  return (stream->ops->sgets(stream->data));
}

static inline int _stream_putc(stream_t *stream, char ch)
{
  return (stream->ops->sputc(stream->data, ch));
}

static inline int _stream_puts(stream_t *stream, char *str)
{
  return (stream->ops->sputs(stream->data, str));
}

static inline int _stream_close(stream_t *stream)
{
  return (stream->ops->sclose(stream->data));
}

struct zepto *_stream_read_expr(stream_t *stream);

int _stream_tokenize(struct list_head *list, stream_t *stream);

void print_sexpr(struct zepto *expr);

struct zepto *eval(struct env *env, struct zepto *expr);

void zepto_init(void);
void zepto_load_file(const char *path);
void zepto_eval_string(const char *string);

//just useful
struct zepto *_make_zepto_number(long val);
char* get_error_string(int errnum);

#endif
